Reference file for NHSplots development

Standard Visualisations in Q-Markdown

1 Visualisations

#load packages
source("R/nhs_style.R")
library(ggrepel)
library(tidyverse)
library(dplyr)
library(gapminder)
library(lemon) # for axis options
library(formattable)
library(sf) # spatial data

1.1 Bar Charts

Reference (see Figure 1).

Show code

#Prepare data
bar_df <- gapminder %>%
  filter(year == 2007 & continent == "Africa") %>%
  arrange(desc(lifeExp)) %>%
  head(5)

#Make plot
ggplot(bar_df, aes(x = reorder(country, desc(lifeExp)), y = lifeExp, label = round(lifeExp, digits = 0))) +
  geom_col(fill= nhs_palette("nhs_blues")) +
  geom_label(nudge_y = -5, size = 5) +
  # theme(axis.text.x = element_text(angle=45, vjust=1, hjust=1)) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  nhs_style() +
  labs(title="Bar Chart Title",
       subtitle = "Bar Chart Sub-Title",
       x = "Country",
       y = "Life Expectancy (Years)"
       )

Figure 1: Life Expectancy in Africa, 2007. Data source (Bryan 2017)

1.1.1 Bar chart with highligted value

Show code

#Prepare data
bar_df <- gapminder %>%
  filter(year == 2007 & continent == "Africa") %>%
  arrange(desc(lifeExp)) %>%
  head(5)

# Find max life expectancy
maxLife <- bar_df[which.max(bar_df$lifeExp), ]

#Make plot
ggplot(bar_df, aes(x = reorder(country, desc(lifeExp)), y = lifeExp)) +
  geom_bar(stat="identity", 
           position="identity", 
           fill="#005EB8") +
  geom_bar(stat="identity", position="identity", fill=ifelse(bar_df$country == maxLife$country, "#005EB8", "#dddddd")) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  nhs_style() +
  labs(subtitle = paste(
            "Life expectancy in",
            maxLife$country,
            "is",
            format(round(maxLife$lifeExp, 0), nsmall = 0),
            "Years"
            ), 
            x = "Country",
            y = "Life Expectancy (Years)"
       )

Figure 2: Life Expectancy in Africa, 2007. Data source (Bryan 2017)

1.1.2 Horizontal Bar Chart

Show code

#Prepare data
bar_df <- gapminder %>%
  filter(year == 2007 & continent == "Africa") %>%
  arrange(desc(lifeExp)) %>%
  head(5)

#Make plot
ggplot(bar_df, aes(x = reorder(country, lifeExp), y = lifeExp)) +
  geom_bar(stat="identity", 
           position="identity", 
           fill="#005EB8") +
  # theme(axis.text.x = element_text(angle=45, vjust=1, hjust=1)) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  nhs_style() +
  coord_flip() +
  theme(panel.grid.major.x = element_line(color="#cbcbcb"), 
        panel.grid.major.y=element_blank()) +
  labs(x = "Country",
    y = "Life Expectancy (Years)"
    )

Figure 3: Life Expectancy in Africa, 2007. Data source (Bryan 2017)

1.1.3 Pyramid Chart

Show code

set.seed(100)
a <- seq(from = 0, to = 90, by = 10)
d <- data.frame(age = paste(a, a + 10, sep = "-"),
                sex = rep(x = c("Female", "Male"), each = 10),
                pop = sample(x = 1:100, size = 20)+100)

ggplot(data = d, 
       mapping = aes(x = ifelse(test = sex == "Male", yes = -pop, no = pop), 
                     y = age, fill = sex)) +
  geom_col() +
  scale_x_symmetric(labels = abs) +
  labs(x = "Population Count",
       y = "Age Group (Years)") +
  nhs_style() +
  scale_fill_discrete(breaks=c("Male","Female")) # sort legend lable order

Figure 4: Age / sex distribution.

1.2 Line Charts

1.2.1 Line chart with latest value KPI

Show code

#Prepare data
line_df <- gapminder %>%
  filter(country == "Malawi")

# get latest metric value for KPI
latestDate <- max(line_df$year)
latestDate_value <- line_df %>% 
      filter(year == latestDate)

#Make plot
ggplot(line_df, aes(x = year, y = lifeExp)) +
  geom_line(colour = "#005EB8", size = 1) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  nhs_style() +
  ylim(c(0, max(line_df$lifeExp)+10)) + # add space above line
  labs(subtitle = paste(
            "Life expectancy in Malawi is",
            format(round(latestDate_value$lifeExp, 0), nsmall = 0),
            "as of",
            format(latestDate, format="%Y")
       )
  )

Figure 5: Life expectancy in Malawi 1952-2007. Data source (Bryan 2017)

Show code

test <- (paste("Life expectancy in Malawi is",
      format(round(latestDate_value$lifeExp, 0), nsmall = 0),
      "as of",
      format(latestDate, format="%Y")
      ))

latest_date <- paste(format(latestDate, format="%Y"))

Life expectancy in Malawi is 48 as of 2007

This is my 2007 located somewhere in my Markdown document.

todo:

1. Function to create KPI sub-titles

1.2.2 Line chart with target line and lable

Show code

# prepare data
line_df <- gapminder %>%
  filter(country == "Malawi")

# get latest metric value for KPI
latestDate <- max(line_df$year)
latestDate_value <- line_df %>% 
      filter(year == latestDate)

# make plot
ggplot(line_df, aes(x = year, y = lifeExp)) +
  geom_line(colour = "#005EB8", size = 1) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  geom_hline(yintercept=45,  # taget line options
      linetype='dashed',
      size = 1.5,
      colour='#425563') +
  geom_label(                # taget lable options
      aes(
            x = 1952,
            y = 45, label = "Target (45 Years)"
      ),
      hjust = 0.15, 
      vjust = -.3, 
      colour = "#425563", 
      fill = "white", 
      label.size = NA, 
      family="Helvetica", 
      size = 6) +
  nhs_style() +
  ylim(c(0, max(line_df$lifeExp)+10)) # add space above line

Figure 6: Life expectancy in Malawi 1952-2007. Data source (Bryan 2017)

todo:

1. Function to add target as variable with adjustments

1.2.3 Line chart with error bars

Show code

# prepare data
line_df <- gapminder %>%
  filter(country == "Malawi")

# random errors
error <- abs(rnorm(nrow(line_df))+3)

# add error bars
line_df$lowerci = line_df$lifeExp - error
line_df$upperci = line_df$lifeExp + error

# get latest metric value for KPI
latestDate <- max(line_df$year)
latestDate_value <- line_df %>% 
      filter(year == latestDate)

# make plot
ggplot(line_df, aes(x = year, y = lifeExp)) +
  geom_line(colour = "#005EB8", size = 1) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  geom_hline(yintercept=45,  # taget line options
      linetype='dashed',
      size = 1.5,
      colour='#425563') +
  geom_label(                # taget lable options
      aes(
            x = 1952,
            y = 45, label = "Target (45 Years)"
      ),
      hjust = 0.15, 
      vjust = -.3, 
      colour = "#425563", 
      fill = "white", 
      label.size = NA, 
      family="Helvetica", 
      size = 6) +
  nhs_style() +
  ylim(c(0, max(line_df$lifeExp)+10)) + # add space above line +
  geom_errorbar(data = line_df, aes(x = year, 
                             ymin = lowerci,
                             ymax = upperci),
                             width = 1.2,
                             size = 0.3,
                             alpha = 0.5)

Figure 7: Life expectancy in Malawi 1952-2007. Data source (Bryan 2017)

1.3 Multi-Line Chart with data lables

Show code

#Prepare data
line_df <- gapminder %>%
  filter(country %in% c("Algeria","Libya", "Mauritius", "Reunion", "Tunisia"))

latest_values <- line_df %>%
  top_n(1, year) 

#Make plot
ggplot(line_df, aes(x = year, y = lifeExp, xend = 2010, yend = 100, colour = country)) +
  geom_line(size = 1) +
  scale_color_manual(values=nhs_palette("nhs_blues")) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  nhs_style() +
  theme(legend.position="none", 
        plot.margin = margin(0,2,0,0, "cm")) +
  labs(title="Line Chart Title",
       subtitle = "Line Chart Sub-Title",
       x = "Year",
       y = "Life Expectancy (Years)"
      ) +
  coord_cartesian(clip = "off") +
  geom_label_repel(
    aes(label = paste(
            country,
            ": ",
            round(lifeExp, digits = 0),
            sep = ""
            )),
    data = latest_values, 
    size = 4,
    nudge_x = 0, direction = "y", hjust = "left",
    xlim = c(-Inf, Inf),
    ylim = c(-Inf, Inf),
    fill = "white",
    min.segment.length = Inf
    )

Figure 8: Life expectancy in Malawi 1952-2007. Data source (Bryan 2017)

1.4 Multi-Line Chart with Region Colours

Show code

#Prepare data
line_df <- gapminder %>%
  filter(country %in% c("Afghanistan","Albania","Algeria","Angola","Argentina","Australia","Austria","Bahrain","Bangladesh","Belgium","Benin"))

#Make plot
ggplot(line_df, aes(x = year, y = lifeExp, colour = country)) +
  geom_line(size = 1) +
  scale_color_manual(values=nhs_palette("midlands_region")) +
  geom_hline(yintercept = 0, size = 1, colour="#333333") +
  nhs_style() +
  theme(legend.position = "top", plot.margin = margin(0,0,0,0, "cm")) +
  labs(title="Line Chart Title",
       subtitle = "Line Chart Sub-Title",
       x = "Year",
       y = "Life Expectancy (Years)"
      )

Figure 9: Life expectancy in Malawi 1952-2007. Data source (Bryan 2017)

1.5 Small Multiples

Show code

#Prepare data
line_df <- gapminder %>%
  filter(country %in% c("Afghanistan","Albania","Algeria","Angola","Argentina","Australia","Austria","Bahrain","Bangladesh","Belgium","Benin"))

ggplot(line_df, aes(x = year, y = lifeExp)) +
  geom_line(aes(color = "red"),
            size = 1.5)+
  facet_wrap(~ country, ncol = 3, strip.position = "top")+
  labs(title = "Life expectancy 1952-2007",
       x = "Year",
       y = "Life Expectancy (Years)",
       caption = "Source: Public Health England National flu and COVID-19 surveillance report (week 8, provisional).") +
  scale_y_continuous(limits = c(0,100)) +
  theme(panel.background = element_blank(),
        strip.text = element_text(face = "bold", color = "black"),
        strip.background = element_rect(color = "black", fill = "white"),
        legend.position = "none")
  #scale_x_continuous(breaks=c(1952,2007))+
  #theme(axis.ticks = element_blank(), legend.position = "none") +
  #nhs_style_sm()

Figure 10: Life expectancy 1952-2007. Data source (Bryan 2017)

1.6 Small Table

Show code

#Prepare data
line_df <- gapminder %>%
  filter(country %in% c("Afghanistan","Albania","Algeria","Angola","Argentina","Australia","Austria","Bahrain","Bangladesh","Belgium","Benin"))

# data
latest_values <- line_df %>%
  top_n(1, year) %>%  
  mutate_if(is.numeric, round, digits = 0) %>%
  arrange(desc(lifeExp))

colnames(latest_values) <- c("Country", "Continent", "Year", "Life Expectancy", "Poulation", "GDP Per Capita")

improvement_formatter <- formatter("span", 
    style = x ~ style(font.weight = "bold", 
    color = ifelse(x > 8000, customGreen, ifelse(x < 8000, customRed, "black"))), 
    x ~ icontext(ifelse(x>8000, "arrow-up", "arrow-down"), x)
    )

benchmark <- formatter("colorbar", style = x ~ style(display = "block", 
        padding = "0 4px",
        `border-radius` = "4px",
        #width = "40px",
        `background-color` = ifelse(x > 70,
                   customGreen, ifelse(x < 70, customRed, "black")),
                   NA)
                   )

# Table
latest_values |>
formattable(align =c("l","c","c","r","r","r"), 
            list(`Country` = formatter(
              "span", style = ~ style(display = "block", 
        padding = "0 4px", `border-radius` = "4px", color = "white", `background-color` = nhs_palette("midlands_region"),font.weight = "bold")), 
            `Life Expectancy` = benchmark,
            `GDP Per Capita` = improvement_formatter
            ))#, table.attr = 'style="font-size: 20px;";\"')

Life expectancy 1952-2007.

Country	Continent	Year	Life Expectancy	Poulation	GDP Per Capita
Australia	Oceania	2007	81	20434176	34435
Austria	Europe	2007	80	8199783	36126
Belgium	Europe	2007	79	10392226	33693
Albania	Europe	2007	76	3600523	5937
Bahrain	Asia	2007	76	708573	29796
Argentina	Americas	2007	75	40301927	12779
Algeria	Africa	2007	72	33333216	6223
Bangladesh	Asia	2007	64	150448339	1391
Benin	Africa	2007	57	8078314	1441
Afghanistan	Asia	2007	44	31889923	975
Angola	Africa	2007	43	12420476	4797

1.7 Sparklines

Show code

reactable(
  sparkline_df,
  defaultPageSize = 11,
  columns = list(
    Country = colDef(maxWidth = 120),
    Continent = colDef(maxWidth = 120),
    `GDP Per Capita` = colDef(maxWidth = 170),
    `Life Expectancy (1950-2007)` = colDef(
      cell = react_sparkline(sparkline_df,
        height = 40,
        highlight_points = highlight_points(all='blue'),
        show_area = TRUE,
        line_width = 2,
        labels = c("first", "last"),
        label_size = "1.0em"))
    )
  )

1.8 Deviation Plot

Example graph for displaying deviations from a common reference point or baseline.

Show code

#make data
df <- data.frame(trt=rep(c("Dose 1", "Dose 2", "Dose 3"), each=4),
                 visit=rep(c(1, 2, 3, 4),3),
                 response=c(0, 0.7, 0.8, 0.6, 
                            0, 0.5, 0.6, 0.2,
                            0, -0.2, -0.6, -0.9 ))

ggplot(df, aes(x=visit, y=response, group=trt, colour=trt)) + 
  geom_hline(yintercept = 0, size = 1, colour="#333333") + 
  geom_point(size=3) +
  geom_line(size=1) +
  scale_y_continuous(limits = c(-1, 1), breaks = c(-1,-0.5,0,0.5,1)) +
  nhs_style() +
  labs(y = "Response",
       x = "Visits"
       )

Figure 11: Deviation

1.9 Correlation Plot

For displaying the relationship between them two or more variables.

Show code

set.seed(1984)
# Create some data
df <- data.frame(cause=c(runif(40,1,10))   )
df$effect <- df$cause*(rnorm(40,2,0.5)) + rnorm(40,0,1)

ggplot(df, aes(x=cause, y=effect)) + 
  geom_point(size=4.5, shape = 16,position="jitter") +
  geom_smooth(method = "lm") +        
  scale_y_continuous(expand=c(0,0.5)) +
  scale_x_continuous(expand=c(0,0.5)) +
  nhs_style() +
  labs(y = "Effect",
       x = "Cause"
       )

Figure 12: Correlation

1.10 Scatter Plots

Show code

# prepare data
data("midwest", package = "ggplot2")
options(scipen=999)  # turn-off scientific notation like 1e+48

# make plot
ggplot(midwest, aes(x=area, y=poptotal)) + 
  geom_point(aes(col=state, size=popdensity)) + 
  xlim(c(0, 0.1)) + 
  ylim(c(0, 500000)) + 
  labs(y="Population", x="Area") +
  nhs_style()

Figure 13: Population vs land area in mid-western USA.

1.11 Box Plot

Show code

# Plot
g <- ggplot(mpg, aes(class, cty))
g + geom_boxplot(varwidth=T, fill="#005EB8") + 
    labs(
         x="Class of Vehicle",
         y="City Mileage") +
    nhs_style()

Figure 14: City Mileage grouped by class of vehicle, USA.

1.12 Tables

Show code

# data
line_df <- gapminder %>%
  filter(country %in% c("Algeria","Libya", "Mauritius", "Reunion", "Tunisia"))

latest_values <- line_df %>%
  top_n(1, year) %>%  
  mutate_if(is.numeric, round, digits = 0) %>%
  arrange(desc(lifeExp))

colnames(latest_values) <- c("Country", "Continent", "Year", "Life Expectancy", "Poulation", "GDP Per Capita")

improvement_formatter <- formatter("span", 
    style = x ~ style(font.weight = "bold", 
    color = ifelse(x > 8000, customGreen, ifelse(x < 8000, customRed, "black"))), 
    x ~ icontext(ifelse(x>8000, "arrow-up", "arrow-down"), x)
    )

# Table
formattable(latest_values,
            align =c("l","c","c","r","r","r"), 
            list(`Country` = formatter(
              "span", style = ~ style(color = "grey",font.weight = "bold")), 
            `Life Expectancy` = color_tile(customGreen0, customGreen),
            `GDP Per Capita` = improvement_formatter
            ))

Life expectancy in Africa 1952-2007.

Country	Continent	Year	Life Expectancy	Poulation	GDP Per Capita
Reunion	Africa	2007	76	798094	7670
Libya	Africa	2007	74	6036914	12057
Tunisia	Africa	2007	74	10276158	7093
Mauritius	Africa	2007	73	1250882	10957
Algeria	Africa	2007	72	33333216	6223

Data source (Bryan 2017)

2 Maps

Show code

Metric <- mapData$colourvalue

ggplot() +
    geom_sf(data = ukMap, fill= "antiquewhite") +
    geom_sf(data = mapData, fill= mapData$hex_colour) +
    theme(panel.grid.major = element_line(
      color = gray(.3),
    linetype = "dashed",
    size = 0.3),
    panel.background = element_rect(
      fill = "aliceblue")) +
    coord_sf(xlim = c(-6, 2), ylim = c(50,56)) #+
    #geom_text_repel(data = mapData ,aes(x = LONG,
                    #y = LAT,
                    #nudge_x = 5,
                    #nudge_y = 53,
                    #label = ICB22NM.x)
                    #)

Figure 15: ICB Map.

Show code

londonMap <- mapData %>%
  filter(NHSEREGCD %in% c("Y56"))

ggplot() +
    geom_sf(data = londonMap, fill = "#00A499", colour = "#FFFFFF", lwd = 1.5) +
    theme(panel.background = element_rect(fill = "white"),
          axis.title=element_blank(),
          axis.text=element_blank(),
          axis.ticks=element_blank(),
          plot.title = element_text(colour = "#005EB8", size = 60),
          plot.subtitle = element_text(colour = "#005EB8", size = 25)) +
    labs(title = londonMap$NHSEREGNM,
         subtitle = "England")

Figure 16: London ICB Map.

2.1 Hex Map

Ref: https://open-innovations.org/blog/2022-07-19-nhs-pcns-as-a-hex-cartogram

Show code

hexData <- hexData %>%
  filter(Region.Code %in% c("Y56"))

ggplot() +
    geom_sf(data = hexData, fill= hexData$colour) +
    theme(panel.background = element_rect(fill = "white"),
          axis.title=element_blank(),
          axis.text=element_blank(),
          axis.ticks=element_blank())

Figure 17: London ICB Hex Map.

3 References

Bryan, Jennifer. 2017. Gapminder R Package.